perm filename LIBHED.SAI[X,AIL] blob
sn#053545 filedate 1973-08-19 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 BEGIN "LIBHED"
00004 ENDMK
⊗;
BEGIN "LIBHED"
INTEGER COUNT,TYPEWD,BLKSIZ,BRK,EOF; DEFINE SRC=1, DST=2;
INTEGER ARRAY BLOCK[0:17];
PROCEDURE GETBLK;
BEGIN "GETBLK"
IF COUNT=0 THEN BEGIN
TYPEWD ← WORDIN(SRC);
COUNT ← TYPEWD LAND '777777;
TYPEWD ← TYPEWD LSH -18
END;
WORDIN(SRC);
ARRYIN(SRC,BLOCK[0],BLKSIZ ← COUNT MIN 18);
COUNT ← COUNT - BLKSIZ
END "GETBLK";
PROCEDURE PUTBLK(INTEGER TYPE, VAL1, VAL2);
BEGIN "PUTBLK"
INTEGER CT;
WORDOUT(DST,TYPE LSH 18 + (CT←CASE TYPE OF (0,0,2,0,1,1,2)));
WORDOUT(DST,IF TYPE=5 THEN '2 LSH 33 ELSE 0);
WORDOUT(DST,VAL1);
IF CT=2 THEN WORDOUT(DST,VAL2);
END "PUTBLK";
OPEN(SRC,"DSK",'10,2,0,0,BRK,EOF);
OPEN(DST,"DSK",'10,0,2,0,COUNT,COUNT);
LOOKUP(SRC,"HEAD.REL",COUNT);
ENTER(DST,"HEAD.LIB",COUNT);
COUNT←0;
DO GETBLK UNTIL TYPEWD=2;
DO BEGIN
INTEGER B,C;
C←BLOCK[0];
IF (LDB(POINT(6,C,5)) LAND '74) = '44 THEN BEGIN
PUTBLK(4,B←C LAND '37777777777,0);
PUTBLK(6,B,0);
PUTBLK(2,C,BLOCK[1]);
PUTBLK(5,0,0);
END;
GETBLK
END UNTIL TYPEWD=5;
COMMENT AS FUDGE2 DOES NOT COPY THE LAST ELEMENT WE MUST PROVIDE A DUMMY;
PUTBLK(4,'77,0);
PUTBLK(6,'77,0);
PUTBLK(2,'100000000077,0);
PUTBLK(5,0,0);
RELEASE(SRC); RELEASE(DST)
END "LIBHED";